home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / win / pascal / janus.exe / DIALOGWN.PAS < prev    next >
Pascal/Delphi Source File  |  1993-06-02  |  20KB  |  668 lines
  1. Unit DialogWn;
  2. { Unit:      DialogWn
  3.   Version:   1.07
  4.   Purpose:   make a descendant of tWindow named tDialogWindow that behaves like
  5.              a modeless or modal dialog.
  6.   Features:  - tDialogWindow descends from tWindow
  7.              - tDialogWindow and descendants may be used as MDI childs
  8.              - support for calculated resources is included e.g. a dialog
  9.                childs class & style may be changed on-the-fly (see GetChildClass)
  10.                tJanusDialogWindow object is an example for this: it decides at
  11.                runtime whether to uses BorDlg's or standard dialogs
  12.              - support DropDownBoxes just like a dialog (tWindow doesn't)
  13.   Date:      02/06/93
  14.  
  15.   Developer: Peter Sawatzki (PS)
  16.              Buchenhof 3, D-5800 Hagen 1, Germany
  17.  CompuServe: 100031,3002
  18.  
  19.   Date:     Author:
  20.   04/22/92  PS       initial release by PS
  21.   07/25/92  PS/jwp   added Scroller support
  22.   08/01/92  PS       added RunModal and modal support
  23.   08/12/92  PS       removed SetClassName and NewClass, fixed bug in MDI support
  24.   08/14/92  PS       fixed Focus problems in MDI, give focus to first ws_TabStop child
  25.   08/30/92  PS       fixed more focus problems in MDI, added SysModal support
  26.   09/27/92  PS       call DefDlgProc to support DropDownBoxes and Multiline edit controls
  27.   10/21/92  PS       some changes for new OWL
  28.   01/28/93  PS       add LoadMenu for automatic menu load
  29.   02/06/93  PS       add support for InitResource,
  30.                      fix BWCC's WM_NCCREATE glitch
  31.  
  32.  
  33.   Contributing: Jeroen W. Pluimers (jwp)
  34.  
  35.   Copyright (c) 1992 Peter Sawatzki. All Rights Reserved.
  36.  
  37. }
  38. Interface
  39. Uses
  40.   WinTypes,
  41.   Win31,
  42. {$IfDef Custom}
  43.   CustomWn,
  44. {$EndIf}
  45.   Objects,
  46.   oWindows;
  47. Type
  48.   tChildClass = Record
  49.     wX, wY, wCX, wCY: Integer;
  50.     wID: Word;
  51.     dwStyle: LongInt;
  52.     szClass: Array[0..63] Of Char;
  53.     szTitle: Array[0..131] Of Char;
  54.     CtlDataSize: Byte;
  55.     CtlData: Array[0..255] Of Byte;
  56.   End;
  57.  
  58.   tDialogWindowAttr = Record
  59.     Name: pChar;
  60.     ItemCount: Integer;
  61.     MenuName,
  62.     ClassName,
  63.     FontName: pChar;
  64.     Font: hFont;
  65.     PointSize: Integer;
  66.     DlgItems: Pointer;
  67.     ResW,
  68.     ResH: Integer;
  69.     wUnitsX,
  70.     wUnitsY: Word
  71.   End;
  72.  
  73. {$IfDef Custom}
  74.   Ancestor = tCustomWindow;
  75. {$Else}
  76.   Ancestor = tWindow;
  77. {$EndIf}
  78.   pDialogWindow = ^tDialogWindow;
  79.   tDialogWindow = Object(Ancestor)
  80.     DialogAttr: tDialogWindowAttr;
  81.     ModalCode: pInteger;
  82.     Constructor Init (aParent: pWindowsObject; aName: pChar);
  83.     Destructor Done;                   Virtual;
  84.     Function  Create: Boolean;         Virtual;
  85.     Procedure Destroy;                 Virtual;
  86.     Procedure SetupWindow;             Virtual;
  87.     Procedure GetWindowClass (Var aWndClass: tWndClass); Virtual;
  88.     Function  GetWindowProc: tFarProc; Virtual;
  89.     Procedure DefWndProc (Var Msg: tMessage); Virtual;
  90.     Procedure DefDialogProc (Var Msg: tMessage); Virtual;
  91.     Procedure wmPaint(Var Msg: tMessage); Virtual wm_First+wm_Paint;
  92.     Function  GetClassName: pChar;     Virtual;
  93.     Procedure GetChildClass (Var aChildClass: tChildClass); Virtual;
  94.     Function  CreateDialogChild (Var aChildClass: tChildClass): hWnd; Virtual;
  95.     Function  CreateDialogChildren: Boolean; Virtual;
  96.     Procedure CreateDialogFont;
  97.     Procedure GetDialogInfo (aPtr: Pointer);
  98.     Procedure UpdateDialog;            Virtual;
  99.     Function  RunModal: Integer;       Virtual;
  100.     Procedure EndDlg (aRetValue: Integer); Virtual;
  101.     Function  GetItemHandle (DlgItemID: Integer): hWnd;
  102.     Function  SendDlgItemMsg (DlgItemID: Integer; aMsg, wParam: Word; lParam: LongInt): LongInt;
  103.     Procedure Ok (Var Msg: tMessage);           Virtual id_First+id_Ok;
  104.     Procedure Cancel (Var Msg: tMessage);       Virtual id_First+id_Cancel;
  105.     Procedure wmClose (Var Msg: tMessage);      Virtual wm_First+wm_Close;
  106.     Procedure wmSetFocus (Var Msg:  tMessage);  Virtual wm_First+wm_SetFocus;
  107.     Procedure wmSize (Var Msg: tMessage);       Virtual wm_First+wm_Size;
  108.     Procedure wmLButtonDown (Var Msg: tMessage);Virtual wm_First+wm_LButtonDown;
  109.   End;
  110.  
  111.   pJanusDialogWindow = ^tJanusDialogWindow;
  112.   tJanusDialogWindow = Object(tDialogWindow)
  113.     useBWCC: Boolean;
  114.     Constructor Init (aParent: pWindowsObject; aName: pChar; BorStyle: Boolean);
  115.     Function  GetWindowProc: tFarProc; Virtual;
  116.     Procedure GetChildClass (Var aChildClass: tChildClass); Virtual;
  117.   End;
  118.  
  119.   Function ExecDialogWindow (aDialogWindow: pDialogWindow): Integer;
  120.  
  121. Implementation
  122. Uses
  123.   WinProcs,
  124.   Strings;
  125. Const
  126.   sztDialogWindow = 'tDialogWindow';
  127.  
  128.   ws_MdiChild   = ws_Child Or ws_ClipSiblings Or ws_SysMenu Or ws_Caption Or
  129.                   ws_ThickFrame Or ws_MinimizeBox Or ws_MaximizeBox Or ws_Visible;
  130.   ws_MdiAllowed = ws_MdiChild Or ws_Minimize Or ws_Maximize Or ws_ClipChildren Or
  131.                   ws_Disabled Or ws_HScroll Or ws_VScroll;
  132.  
  133.   BorDialog = 'BorDlg';
  134.   BorButton = 'BorBtn';
  135.   BorRadio  = 'BorRadio';
  136.   BorCheck  = 'BorCheck';
  137.   BorShade  = 'BorShade';
  138.   BorStatic = 'BorStatic';
  139.  
  140.   bss_Group = 1; {group box}
  141.   bss_Hdip  = 2; {horizontal border}
  142.   bss_Vdip  = 3; {hertical border}
  143.   bss_Hbump = 4; {horizontal speed bump}
  144.   bss_Vbump = 5; {vertical speed bump}
  145.  
  146.   BWCCInst: tHandle = tHandle(0);
  147.   aBWCCDefMdiChildProc: tDefaultProc = Nil;
  148.   aBWCCDefWindowProc:   tDefaultProc = Nil;
  149.   aBWCCDefDlgProc:      tDefaultProc = Nil;
  150.  
  151.   wm_EnterMenuLoop = $0211; {undocumented}
  152.  
  153. Function DlgToClientX (x, Units: Integer): Integer;
  154. {DlgToClientX:= x*Units Div 4}
  155. Inline($59/$58/    {Pop Cx Ax}
  156.        $F7/$E1/    {Mul Cx}
  157.        $D1/$E8/    {Shr Ax,1}
  158.        $D1/$E8);   {Shr Ax,1}
  159.  
  160. Function DlgToClientY (y, Units: Integer): Integer;
  161. {DlgToClientY:= y*Units Div 8}
  162. Inline($59/$58/    {Pop Cx Ax}
  163.        $F7/$E1/    {Mul Cx}
  164.        $D1/$E8/    {Shr Ax,1}
  165.        $D1/$E8/    {Shr Ax,1}
  166.        $D1/$E8);   {Shr Ax,1}
  167.  
  168. Constructor tDialogWindow.Init (aParent: pWindowsObject; aName: pChar);
  169. Begin
  170.   Inherited Init(aParent,sztDialogWindow); {fake title}
  171.   FillChar(DialogAttr,SizeOf(DialogAttr),0);
  172.   ModalCode:= Nil;                        {assume modeless window}
  173.   With DialogAttr Do
  174.     If PtrRec(aName).Seg=0 Then Name:= aName Else Name:= StrNew(aName);
  175.   DefaultProc:= GetWindowProc
  176. End;
  177.  
  178. Destructor tDialogWindow.Done;
  179. Begin
  180.   With DialogAttr Do Begin
  181.     If PtrRec(Name).Seg<>0 Then StrDispose(Name);
  182.     If PtrRec(MenuName).Seg<>0 Then StrDispose(MenuName);
  183.     StrDispose(ClassName);
  184.     StrDispose(FontName)
  185.   End;
  186.   Inherited Done
  187. End;
  188.  
  189. Function tDialogWindow.Create: Boolean;
  190. Var
  191.   aResInfo, aRes: tHandle;
  192.   oStyle: LongInt;
  193. Begin
  194.   Create:= False;
  195.   If (Status<>0) Or (DialogAttr.Name=Nil) Then
  196.     Exit;
  197.   aResInfo:= FindResource(hInstance, DialogAttr.Name, rt_Dialog);
  198.   If aResInfo<>0 Then
  199.     aRes:= LoadResource(hInstance, aResInfo);
  200.   If (aResInfo=0) Or (aRes=0) Then
  201.     Status:= em_InvalidWindow
  202.   Else Begin
  203.     If ModalCode<>Nil Then
  204.       If Parent=Nil Then Begin
  205.         Status:= em_InvalidWindow;
  206.         Exit
  207.       End Else Begin
  208.         EnableWindow(Parent^.hWindow,False); {disable Parent}
  209.         ModalCode^:= 0                       {begin modal state}
  210.       End;
  211.     GetDialogInfo(LockResource(aRes));
  212.     If DialogAttr.MenuName<>Nil Then
  213.       Attr.Menu:= LoadMenu(hInstance, DialogAttr.MenuName);
  214.     CreateDialogFont;
  215.     UpdateDialog;
  216.     EnableKBHandler;
  217.     oStyle:= Attr.Style; Attr.Style:= Attr.Style And Not ws_Visible;
  218.     Create:= Inherited Create;
  219.     Attr.Style:= oStyle;
  220.     If Attr.Style And ws_Visible<>0 Then
  221.       ShowWindow(hWindow, sw_Show);
  222.     UnlockResource(aRes);
  223.     FreeResource(aRes)
  224.   End
  225. End;
  226.  
  227. Procedure tDialogWindow.Destroy;
  228. Begin
  229.   If (ModalCode<>Nil) And (Parent<>Nil) Then Begin
  230.     EnableWindow(Parent^.hWindow,True); {enable Parent}
  231.     If ModalCode^=0 Then {terminate modal window if not already terminated}
  232.       ModalCode^:= id_Cancel
  233.   End;
  234.  
  235.   If DialogAttr.FontName<>Nil Then
  236.     DeleteObject(DialogAttr.Font);
  237.   Inherited Destroy
  238. End;
  239.  
  240. Procedure tDialogWindow.SetupWindow;
  241. Begin
  242.   Send